<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html>
 <head>
  <title>cgebal.f</title>
 <meta name="generator" content="emacs 21.3.1; htmlfontify 0.20">
<style type="text/css"><!-- 
body { background: rgb(255, 255, 255);  color: rgb(0, 0, 0);  font-style: normal;  font-weight: 500;  font-stretch: normal;  font-family: adobe-courier;  font-size: 11pt;  text-decoration: none; }
span.default   { background: rgb(255, 255, 255);  color: rgb(0, 0, 0);  font-style: normal;  font-weight: 500;  font-stretch: normal;  font-family: adobe-courier;  font-size: 11pt;  text-decoration: none; }
span.default a { background: rgb(255, 255, 255);  color: rgb(0, 0, 0);  font-style: normal;  font-weight: 500;  font-stretch: normal;  font-family: adobe-courier;  font-size: 11pt;  text-decoration: underline; }
span.string   { color: rgb(188, 143, 143);  background: rgb(255, 255, 255);  font-style: normal;  font-weight: 500;  font-stretch: normal;  font-family: adobe-courier;  font-size: 11pt;  text-decoration: none; }
span.string a { color: rgb(188, 143, 143);  background: rgb(255, 255, 255);  font-style: normal;  font-weight: 500;  font-stretch: normal;  font-family: adobe-courier;  font-size: 11pt;  text-decoration: underline; }
span.comment   { color: rgb(178, 34, 34);  background: rgb(255, 255, 255);  font-style: normal;  font-weight: 500;  font-stretch: normal;  font-family: adobe-courier;  font-size: 11pt;  text-decoration: none; }
span.comment a { color: rgb(178, 34, 34);  background: rgb(255, 255, 255);  font-style: normal;  font-weight: 500;  font-stretch: normal;  font-family: adobe-courier;  font-size: 11pt;  text-decoration: underline; }
 --></style>

 </head>
  <body>

<pre>
      SUBROUTINE <a name="CGEBAL.1"></a><a href="cgebal.f.html#CGEBAL.1">CGEBAL</a>( JOB, N, A, LDA, ILO, IHI, SCALE, INFO )
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  -- LAPACK routine (version 3.1) --
</span><span class="comment">*</span><span class="comment">     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
</span><span class="comment">*</span><span class="comment">     November 2006
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     .. Scalar Arguments ..
</span>      CHARACTER          JOB
      INTEGER            IHI, ILO, INFO, LDA, N
<span class="comment">*</span><span class="comment">     ..
</span><span class="comment">*</span><span class="comment">     .. Array Arguments ..
</span>      REAL               SCALE( * )
      COMPLEX            A( LDA, * )
<span class="comment">*</span><span class="comment">     ..
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  Purpose
</span><span class="comment">*</span><span class="comment">  =======
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  <a name="CGEBAL.19"></a><a href="cgebal.f.html#CGEBAL.1">CGEBAL</a> balances a general complex matrix A.  This involves, first,
</span><span class="comment">*</span><span class="comment">  permuting A by a similarity transformation to isolate eigenvalues
</span><span class="comment">*</span><span class="comment">  in the first 1 to ILO-1 and last IHI+1 to N elements on the
</span><span class="comment">*</span><span class="comment">  diagonal; and second, applying a diagonal similarity transformation
</span><span class="comment">*</span><span class="comment">  to rows and columns ILO to IHI to make the rows and columns as
</span><span class="comment">*</span><span class="comment">  close in norm as possible.  Both steps are optional.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  Balancing may reduce the 1-norm of the matrix, and improve the
</span><span class="comment">*</span><span class="comment">  accuracy of the computed eigenvalues and/or eigenvectors.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  Arguments
</span><span class="comment">*</span><span class="comment">  =========
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  JOB     (input) CHARACTER*1
</span><span class="comment">*</span><span class="comment">          Specifies the operations to be performed on A:
</span><span class="comment">*</span><span class="comment">          = 'N':  none:  simply set ILO = 1, IHI = N, SCALE(I) = 1.0
</span><span class="comment">*</span><span class="comment">                  for i = 1,...,N;
</span><span class="comment">*</span><span class="comment">          = 'P':  permute only;
</span><span class="comment">*</span><span class="comment">          = 'S':  scale only;
</span><span class="comment">*</span><span class="comment">          = 'B':  both permute and scale.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  N       (input) INTEGER
</span><span class="comment">*</span><span class="comment">          The order of the matrix A.  N &gt;= 0.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  A       (input/output) COMPLEX array, dimension (LDA,N)
</span><span class="comment">*</span><span class="comment">          On entry, the input matrix A.
</span><span class="comment">*</span><span class="comment">          On exit,  A is overwritten by the balanced matrix.
</span><span class="comment">*</span><span class="comment">          If JOB = 'N', A is not referenced.
</span><span class="comment">*</span><span class="comment">          See Further Details.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  LDA     (input) INTEGER
</span><span class="comment">*</span><span class="comment">          The leading dimension of the array A.  LDA &gt;= max(1,N).
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  ILO     (output) INTEGER
</span><span class="comment">*</span><span class="comment">  IHI     (output) INTEGER
</span><span class="comment">*</span><span class="comment">          ILO and IHI are set to integers such that on exit
</span><span class="comment">*</span><span class="comment">          A(i,j) = 0 if i &gt; j and j = 1,...,ILO-1 or I = IHI+1,...,N.
</span><span class="comment">*</span><span class="comment">          If JOB = 'N' or 'S', ILO = 1 and IHI = N.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  SCALE   (output) REAL array, dimension (N)
</span><span class="comment">*</span><span class="comment">          Details of the permutations and scaling factors applied to
</span><span class="comment">*</span><span class="comment">          A.  If P(j) is the index of the row and column interchanged
</span><span class="comment">*</span><span class="comment">          with row and column j and D(j) is the scaling factor
</span><span class="comment">*</span><span class="comment">          applied to row and column j, then
</span><span class="comment">*</span><span class="comment">          SCALE(j) = P(j)    for j = 1,...,ILO-1
</span><span class="comment">*</span><span class="comment">                   = D(j)    for j = ILO,...,IHI
</span><span class="comment">*</span><span class="comment">                   = P(j)    for j = IHI+1,...,N.
</span><span class="comment">*</span><span class="comment">          The order in which the interchanges are made is N to IHI+1,
</span><span class="comment">*</span><span class="comment">          then 1 to ILO-1.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  INFO    (output) INTEGER
</span><span class="comment">*</span><span class="comment">          = 0:  successful exit.
</span><span class="comment">*</span><span class="comment">          &lt; 0:  if INFO = -i, the i-th argument had an illegal value.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  Further Details
</span><span class="comment">*</span><span class="comment">  ===============
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  The permutations consist of row and column interchanges which put
</span><span class="comment">*</span><span class="comment">  the matrix in the form
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">             ( T1   X   Y  )
</span><span class="comment">*</span><span class="comment">     P A P = (  0   B   Z  )
</span><span class="comment">*</span><span class="comment">             (  0   0   T2 )
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  where T1 and T2 are upper triangular matrices whose eigenvalues lie
</span><span class="comment">*</span><span class="comment">  along the diagonal.  The column indices ILO and IHI mark the starting
</span><span class="comment">*</span><span class="comment">  and ending columns of the submatrix B. Balancing consists of applying
</span><span class="comment">*</span><span class="comment">  a diagonal similarity transformation inv(D) * B * D to make the
</span><span class="comment">*</span><span class="comment">  1-norms of each row of B and its corresponding column nearly equal.
</span><span class="comment">*</span><span class="comment">  The output matrix is
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     ( T1     X*D          Y    )
</span><span class="comment">*</span><span class="comment">     (  0  inv(D)*B*D  inv(D)*Z ).
</span><span class="comment">*</span><span class="comment">     (  0      0           T2   )
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  Information about the permutations P and the diagonal matrix D is
</span><span class="comment">*</span><span class="comment">  returned in the vector SCALE.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  This subroutine is based on the EISPACK routine CBAL.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  Modified by Tzu-Yi Chen, Computer Science Division, University of
</span><span class="comment">*</span><span class="comment">    California at Berkeley, USA
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  =====================================================================
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     .. Parameters ..
</span>      REAL               ZERO, ONE
      PARAMETER          ( ZERO = 0.0E+0, ONE = 1.0E+0 )
      REAL               SCLFAC
      PARAMETER          ( SCLFAC = 2.0E+0 )
      REAL               FACTOR
      PARAMETER          ( FACTOR = 0.95E+0 )
<span class="comment">*</span><span class="comment">     ..
</span><span class="comment">*</span><span class="comment">     .. Local Scalars ..
</span>      LOGICAL            NOCONV
      INTEGER            I, ICA, IEXC, IRA, J, K, L, M
      REAL               C, CA, F, G, R, RA, S, SFMAX1, SFMAX2, SFMIN1,
     $                   SFMIN2
      COMPLEX            CDUM
<span class="comment">*</span><span class="comment">     ..
</span><span class="comment">*</span><span class="comment">     .. External Functions ..
</span>      LOGICAL            <a name="LSAME.120"></a><a href="lsame.f.html#LSAME.1">LSAME</a>
      INTEGER            ICAMAX
      REAL               <a name="SLAMCH.122"></a><a href="slamch.f.html#SLAMCH.1">SLAMCH</a>
      EXTERNAL           <a name="LSAME.123"></a><a href="lsame.f.html#LSAME.1">LSAME</a>, ICAMAX, <a name="SLAMCH.123"></a><a href="slamch.f.html#SLAMCH.1">SLAMCH</a>
<span class="comment">*</span><span class="comment">     ..
</span><span class="comment">*</span><span class="comment">     .. External Subroutines ..
</span>      EXTERNAL           CSSCAL, CSWAP, <a name="XERBLA.126"></a><a href="xerbla.f.html#XERBLA.1">XERBLA</a>
<span class="comment">*</span><span class="comment">     ..
</span><span class="comment">*</span><span class="comment">     .. Intrinsic Functions ..
</span>      INTRINSIC          ABS, AIMAG, MAX, MIN, REAL
<span class="comment">*</span><span class="comment">     ..
</span><span class="comment">*</span><span class="comment">     .. Statement Functions ..
</span>      REAL               CABS1
<span class="comment">*</span><span class="comment">     ..
</span><span class="comment">*</span><span class="comment">     .. Statement Function definitions ..
</span>      CABS1( CDUM ) = ABS( REAL( CDUM ) ) + ABS( AIMAG( CDUM ) )
<span class="comment">*</span><span class="comment">     ..
</span><span class="comment">*</span><span class="comment">     .. Executable Statements ..
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     Test the input parameters
</span><span class="comment">*</span><span class="comment">
</span>      INFO = 0
      IF( .NOT.<a name="LSAME.142"></a><a href="lsame.f.html#LSAME.1">LSAME</a>( JOB, <span class="string">'N'</span> ) .AND. .NOT.<a name="LSAME.142"></a><a href="lsame.f.html#LSAME.1">LSAME</a>( JOB, <span class="string">'P'</span> ) .AND.
     $    .NOT.<a name="LSAME.143"></a><a href="lsame.f.html#LSAME.1">LSAME</a>( JOB, <span class="string">'S'</span> ) .AND. .NOT.<a name="LSAME.143"></a><a href="lsame.f.html#LSAME.1">LSAME</a>( JOB, <span class="string">'B'</span> ) ) THEN
         INFO = -1
      ELSE IF( N.LT.0 ) THEN
         INFO = -2
      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
         INFO = -4
      END IF
      IF( INFO.NE.0 ) THEN
         CALL <a name="XERBLA.151"></a><a href="xerbla.f.html#XERBLA.1">XERBLA</a>( <span class="string">'<a name="CGEBAL.151"></a><a href="cgebal.f.html#CGEBAL.1">CGEBAL</a>'</span>, -INFO )
         RETURN
      END IF
<span class="comment">*</span><span class="comment">
</span>      K = 1
      L = N
<span class="comment">*</span><span class="comment">
</span>      IF( N.EQ.0 )
     $   GO TO 210
<span class="comment">*</span><span class="comment">
</span>      IF( <a name="LSAME.161"></a><a href="lsame.f.html#LSAME.1">LSAME</a>( JOB, <span class="string">'N'</span> ) ) THEN
         DO 10 I = 1, N
            SCALE( I ) = ONE
   10    CONTINUE
         GO TO 210
      END IF
<span class="comment">*</span><span class="comment">
</span>      IF( <a name="LSAME.168"></a><a href="lsame.f.html#LSAME.1">LSAME</a>( JOB, <span class="string">'S'</span> ) )
     $   GO TO 120
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     Permutation to isolate eigenvalues if possible
</span><span class="comment">*</span><span class="comment">
</span>      GO TO 50
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     Row and column exchange.
</span><span class="comment">*</span><span class="comment">
</span>   20 CONTINUE
      SCALE( M ) = J
      IF( J.EQ.M )
     $   GO TO 30
<span class="comment">*</span><span class="comment">
</span>      CALL CSWAP( L, A( 1, J ), 1, A( 1, M ), 1 )
      CALL CSWAP( N-K+1, A( J, K ), LDA, A( M, K ), LDA )
<span class="comment">*</span><span class="comment">
</span>   30 CONTINUE
      GO TO ( 40, 80 )IEXC
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     Search for rows isolating an eigenvalue and push them down.
</span><span class="comment">*</span><span class="comment">
</span>   40 CONTINUE
      IF( L.EQ.1 )
     $   GO TO 210
      L = L - 1
<span class="comment">*</span><span class="comment">
</span>   50 CONTINUE
      DO 70 J = L, 1, -1
<span class="comment">*</span><span class="comment">
</span>         DO 60 I = 1, L
            IF( I.EQ.J )
     $         GO TO 60
            IF( REAL( A( J, I ) ).NE.ZERO .OR. AIMAG( A( J, I ) ).NE.
     $          ZERO )GO TO 70
   60    CONTINUE
<span class="comment">*</span><span class="comment">
</span>         M = L
         IEXC = 1
         GO TO 20
   70 CONTINUE
<span class="comment">*</span><span class="comment">
</span>      GO TO 90
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     Search for columns isolating an eigenvalue and push them left.
</span><span class="comment">*</span><span class="comment">
</span>   80 CONTINUE
      K = K + 1
<span class="comment">*</span><span class="comment">
</span>   90 CONTINUE
      DO 110 J = K, L
<span class="comment">*</span><span class="comment">
</span>         DO 100 I = K, L
            IF( I.EQ.J )
     $         GO TO 100
            IF( REAL( A( I, J ) ).NE.ZERO .OR. AIMAG( A( I, J ) ).NE.
     $          ZERO )GO TO 110
  100    CONTINUE
<span class="comment">*</span><span class="comment">
</span>         M = K
         IEXC = 2
         GO TO 20
  110 CONTINUE
<span class="comment">*</span><span class="comment">
</span>  120 CONTINUE
      DO 130 I = K, L
         SCALE( I ) = ONE
  130 CONTINUE
<span class="comment">*</span><span class="comment">
</span>      IF( <a name="LSAME.237"></a><a href="lsame.f.html#LSAME.1">LSAME</a>( JOB, <span class="string">'P'</span> ) )
     $   GO TO 210
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     Balance the submatrix in rows K to L.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     Iterative loop for norm reduction
</span><span class="comment">*</span><span class="comment">
</span>      SFMIN1 = <a name="SLAMCH.244"></a><a href="slamch.f.html#SLAMCH.1">SLAMCH</a>( <span class="string">'S'</span> ) / <a name="SLAMCH.244"></a><a href="slamch.f.html#SLAMCH.1">SLAMCH</a>( <span class="string">'P'</span> )
      SFMAX1 = ONE / SFMIN1
      SFMIN2 = SFMIN1*SCLFAC
      SFMAX2 = ONE / SFMIN2
  140 CONTINUE
      NOCONV = .FALSE.
<span class="comment">*</span><span class="comment">
</span>      DO 200 I = K, L
         C = ZERO
         R = ZERO
<span class="comment">*</span><span class="comment">
</span>         DO 150 J = K, L
            IF( J.EQ.I )
     $         GO TO 150
            C = C + CABS1( A( J, I ) )
            R = R + CABS1( A( I, J ) )
  150    CONTINUE
         ICA = ICAMAX( L, A( 1, I ), 1 )
         CA = ABS( A( ICA, I ) )
         IRA = ICAMAX( N-K+1, A( I, K ), LDA )
         RA = ABS( A( I, IRA+K-1 ) )
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">        Guard against zero C or R due to underflow.
</span><span class="comment">*</span><span class="comment">
</span>         IF( C.EQ.ZERO .OR. R.EQ.ZERO )
     $      GO TO 200
         G = R / SCLFAC
         F = ONE
         S = C + R
  160    CONTINUE
         IF( C.GE.G .OR. MAX( F, C, CA ).GE.SFMAX2 .OR.
     $       MIN( R, G, RA ).LE.SFMIN2 )GO TO 170
         F = F*SCLFAC
         C = C*SCLFAC
         CA = CA*SCLFAC
         R = R / SCLFAC
         G = G / SCLFAC
         RA = RA / SCLFAC
         GO TO 160
<span class="comment">*</span><span class="comment">
</span>  170    CONTINUE
         G = C / SCLFAC
  180    CONTINUE
         IF( G.LT.R .OR. MAX( R, RA ).GE.SFMAX2 .OR.
     $       MIN( F, C, G, CA ).LE.SFMIN2 )GO TO 190
         F = F / SCLFAC
         C = C / SCLFAC
         G = G / SCLFAC
         CA = CA / SCLFAC
         R = R*SCLFAC
         RA = RA*SCLFAC
         GO TO 180
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">        Now balance.
</span><span class="comment">*</span><span class="comment">
</span>  190    CONTINUE
         IF( ( C+R ).GE.FACTOR*S )
     $      GO TO 200
         IF( F.LT.ONE .AND. SCALE( I ).LT.ONE ) THEN
            IF( F*SCALE( I ).LE.SFMIN1 )
     $         GO TO 200
         END IF
         IF( F.GT.ONE .AND. SCALE( I ).GT.ONE ) THEN
            IF( SCALE( I ).GE.SFMAX1 / F )
     $         GO TO 200
         END IF
         G = ONE / F
         SCALE( I ) = SCALE( I )*F
         NOCONV = .TRUE.
<span class="comment">*</span><span class="comment">
</span>         CALL CSSCAL( N-K+1, G, A( I, K ), LDA )
         CALL CSSCAL( L, F, A( 1, I ), 1 )
<span class="comment">*</span><span class="comment">
</span>  200 CONTINUE
<span class="comment">*</span><span class="comment">
</span>      IF( NOCONV )
     $   GO TO 140
<span class="comment">*</span><span class="comment">
</span>  210 CONTINUE
      ILO = K
      IHI = L
<span class="comment">*</span><span class="comment">
</span>      RETURN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     End of <a name="CGEBAL.328"></a><a href="cgebal.f.html#CGEBAL.1">CGEBAL</a>
</span><span class="comment">*</span><span class="comment">
</span>      END

</pre>

 </body>
</html>
